home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr36
/
mapl0301.zip
/
USR-ED.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-04-13
|
25KB
|
836 lines
' Compiler commands or PDS7.1
'bc /O /Fpa /s /G2 /Ot /MBF e:\rbbs\Chat\rbbssub5.bas,rbbssub5.obj;
'
'
' $linesize:132
' $title: 'USR-ED.BAS 17.4, Copyright 1986 - 92 by D. Thomas Mack'
' Copyright 1991 by D. Thomas Mack, all rights reserved.
' Modifications By Peter Eibl (C) 1993 for RBBS 17-4
' Name ...............: USR-ED.BAS
' First Released .....: Jan 24, 1993
' Subsequent Releases.:
' Copyright ..........: 1986 - 1993
' Purpose.............: To move code into sub moduls to free up space
' In RBBS-PC to allow RBBS to have additional
' modifications and still allow the use of
' QuickBasic 3.0 and 4.5 compilers
' Parameters..........: Most parameters are passed via a COMMON statement.
'
' $INCLUDE: 'RBBS-VAR.BAS'
'
' $SUBTITLE: 'Usered - subroutine to edit users from Sysops 5) command'
' $PAGE
'
Sub Usred (EditFromRead,TempHashValue$,UserRecordHold$,RegDateHold$,UserSecLevelSave,WasTu) Static
11001 ZStopInterrupts = ZTrue
WasI = 1
ScanUsers = ZFalse
IF EditFromRead = 1 THEN GOTO 11341
x = 304 'Pe 02/02/93
Gosub 30000 'Pe 02/02/93
ZOutTxt$ = OutTxt$
GOSUB 12930
11003 IF ZWasQ = 0 THEN _
IF EditFromRead > 0 THEN _
GOTO 11325 _
ELSE _
ZUserFileIndex = WasTU : _
GOTO 20093
WasQQ = 0
ZWasZ$ = LEFT$(ZUserIn$(ZAnsIndex),1)
CALL AllCaps (ZWasZ$)
IF ZWasZ$ = "A" THEN _
GOTO 12300 _
ELSE IF ZWasZ$ = "M" THEN _
ZStopInterrupts = ZTrue _
ELSE IF ZWasZ$ = "P" THEN _
WasQQ = ZTrue _
ELSE IF ZWasZ$ = "S" THEN _
ScanUsers = ZTrue : _
ZStopInterrupts = ZTrue _
ELSE IF ZWasZ$ <> "L" THEN _
GOTO 11001
11005 CALL OpenUser (ZHighestUserRecord)
GOSUB 29450
WasZ = 1
IF ScanUsers THEN _
x = 305 : _ 'Pe 02/02/93
Gosub 30000 : _ 'Pe 02/02/93
ZOutTxt$ = OutTxt$ + ZUserLocation$ + ", L)evel" + _
LEFT$(", H)ash id",-9*(ZStartHash > 1 AND ZLenHash > 0)) : _
GOSUB 12930 : _
ZOutTxt$ = "" : _
ScanFunction$ = LEFT$(ZUserIn$(1),1) : _
CALL AllCaps (ScanFunction$) : _
ZCR = 0 : _
GOSUB 12979 : _
GOSUB 12966 : _
GOTO 12962
11010 FOR WasJ = WasZ TO ZHighestUserRecord
GET 5,WasJ
11015 CALL DispUserRec (WasQQ)
IF NOT ZOK THEN _
GOTO 11310
IF ZRet <> 0 THEN _
GOTO 11330
11107 IF NOT ZStopInterrupts THEN _
GOTO 11310
11110 x = 306 'Pe 02/02/93
Gosub 30000 'Pe 02/02/93
ZOutTxt$ = OutTxt$ + ZUserLocation$ + " Q)uit"
CALL TopPrompt
x = 307 'Pe 02/02/93
Gosub 30000 'Pe 02/02/93
ZOutTxt$ = OutTxt$
IF ZRestrictByDate THEN _
ZOutTxt$ = ZOutTxt$ + _
" $)RegDate"
GOSUB 12930
IF NOT ScanUsers AND ZWasQ = 0 THEN _
GOTO 11310
11115 ZWasZ$ = LEFT$(ZUserIn$(ZAnsIndex),1)
CALL AllCaps (ZWasZ$)
WasX = INSTR("DNPQFSMR$UXTBC",ZWasZ$) 'Pe 02/04/92
IF ZWasZ$ = "" AND ScanUsers THEN _
GOTO 12965
ON WasX GOTO 11130,11160,11220,11320,11340,11390,11330, _
11400,11450,11127,11490,11420,11423,11190 'Pe 02/04/92
GOTO 11110
11125 WasZ = VAL(ZUserIn$)
IF WasZ < 1 OR WasZ > ZHighestUserRecord THEN _
GOTO 11127
GOTO 11010
11127 x = 308 'Pe 02/02/93
Gosub 30000 'Pe 02/02/93
ZOutTxt$ = OutTxt$
GOSUB 12932
GOTO 11125
'
' * D - COMMAND FROM 5- USER MAINTENANCE OPTIONS (DELETE USER)
'
11130 x = 309 'Pe 02/02/93
Gosub 30000 'Pe 02/02/93
ZOutTxt$ = OutTxt$
GOSUB 12995
IF ZYes THEN _
LSET ZUserName$ = CHR$(0) + _
"deleted user" : _
LSET ZSecLevel$ = MKI$(ZMinLogonSec - 1) : _
LSET ZLastDateTimeOn$ = "01-01-80" + _
" " + _
ZTimeLoggedOn$
GOTO 11290
'
' * N - COMMAND FROM 5- USER MAINTENANCE OPTIONS (CHANGE USER PASSWORD)
'
11160 GOSUB 12800
GOTO 11290
11185 CALL QuickTPut1 (ZUserLocation$ + " now " + ZWasCI$)
WasA1$ = "Enter new "
RETURN
11190 ' *** C - COMMAND FROM 5 - CHANGE CITY/STATE ***
CityStateSave$ = ZWasCI$
ZWasCI$ = ZCityState$
CALL Trim (ZWasCI$)
GOSUB 11185
GOSUB 12960
ZWasCI$ = CityStateSave$
GOTO 11290
11220 WasQQ = NOT WasQQ
GOTO 11015
11290 ZUserFileIndex = LOC(5)
GOSUB 12989
GOSUB 29440
GOSUB 12991
ZUserFileIndex = 0
GOTO 11015
11310 IF ScanUsers THEN _
GOTO 12965
11311 NEXT
'
' * Q - COMMAND FROM 5- USER MAINTENANCE OPTIONS (QUIT TO MAIN MENU)
'
11320 ZUserFileIndex = WasTU
LSET ZUserRecord$ = UserRecordHold$
ZRegDate$ = RegDateHold$
IF EditFromRead > 0 THEN _
GOTO 11325
Exit Sub
11325 ZReply = ZFalse
JustReplied = ZTrue
QuotedReply = ZTrue
EditFromRead = 0
CALL GetMsgAttr
DontPrint = ZTrue
ZUserIn$ = "="
EditFromRead = 3
Exit Sub
'
' * M - COMMAND FROM 5- USER MAINTENANCE OPTIONS (MAIN USER MAINT. MENU)
'
11330 CLOSE 2
IF EditFromRead > 0 THEN _
EditFromRead = 2
GOTO 11001
'
' * F - COMMAND FROM 5- USER MAINTENANCE OPTIONS (FIND USER)
'
11340 ZOutTxt$ = ZPromptHash$ + _
" to find"
CALL SkipLine (1)
ZParseOff = ZTrue
GOSUB 12932
IF ZWasQ = 0 THEN _
GOTO 11340
TempHashValue$ = ZUserIn$
11341 IF LEN(TempHashValue$) < 3 OR LEN(TempHashValue$) > ZLenHash THEN _
GOTO 11340
CALL AllCaps (TempHashValue$)
IF ZStartIndiv < 1 THEN _
GOTO 11345
11342 ZOutTxt$ = ZPromptIndiv$ + _
" to find"
GOSUB 12995
IF ZWasQ = 0 THEN _
GOTO 11342
TempIndivValue$ = ZUserIn$
IF LEN(TempIndivValue$) > ZLenIndiv THEN _
GOTO 11342
CALL AllCaps (TempIndivValue$)
11345 GOSUB 12600
GOSUB 12990
GOSUB 12987
ZUserFileIndex = 0
IF Found THEN _
GOTO 11015
11380 ZOutTxt$ = TempHashValue$ + _
" " + _
TempIndivValue$ + _
" not found"
GOSUB 12977
GOTO 11310
'
' * S - COMMAND FROM 5- USER MAINTENANCE OPTIONS (CHANGE USER SECURITY)
'
11390 GOSUB 11395
LSET ZSecLevel$ = MKI$(WasOF)
GOTO 11290
11395 ZOutTxt$ = "New sec level"
GOSUB 12932
ZWasZ$ = ZUserIn$(ZAnsIndex)
WasOF = VAL(ZWasZ$)
IF WasOF > ZUserSecLevel THEN _
WasOF = ZUserSecLevel
RETURN
'
' * R - COMMAND FROM 5- USER MAINTENANCE OPTIONS (RESET USER GRAPHICS)
'
11400 ZWasA = CVI(MID$(ZUserOption$,9,2))
ZWasA = ZWasA AND &HFAFF ' TURN HIGHLIGHTING OFF
LSET ZUserOption$ = LEFT$(ZUserOption$,5) + _
"0" + _
MID$(ZUserOption$,7,2) + _
MKI$(ZWasA) + _
MID$(ZUserOption$,11)
GOTO 11290
11420 ' * T - COMMAND FROM 5 - TIME USED
Temp = CVI (ZElapsedTime$)
CALL ChangeInt (ZTrue,"Time Used",Temp,-21900,2000)
IF ZWasQ <> 0 THEN _
LSET ZElapsedTime$ = MKI$(ZTestedIntValue)
GOTO 11290
11423 ' * B - COMMAND FROM 5 - BANKED TIME
Temp = ASC(ZBankTime$)
CALL ChangeInt (ZTrue,"Banked Time",Temp,0,255)
IF ZWasQ <> 0 THEN _
LSET ZBankTime$ = CHR$(ZTestedIntValue)
GOTO 11290
'
' * $ - COMMAND FROM 5 - USER MAINTENANCE (CHANGE REGISTRATION DATE)
'
11450 ZOutTxt$ = "Enter new registration date (MM-DD-YY)"
GOSUB 12932
IF ZWasQ = 0 THEN _
GOTO 11015
11455 WorkDate$ = ZUserIn$(ZAnsIndex)
IF LEN(WorkDate$) < 8 THEN _
GOTO 11450
CALL ResetRegDate (WorkDate$)
IF NOT ZOK THEN _
GOTO 11450
LSET ZUserOption$ = LEFT$(ZUserOption$,10) + _
ZRegDate$ + _
MID$(ZUserOption$,13)
CALL SetRegDisplay
ZRegDate$ = RegDateHold$
GOTO 11290
'
' * X - COMMAND FROM 5 - USER MAINTENANCE (CHANGE XFER COUNTERS) *
'
11490 CALL CmndSysOpXfer
GOTO 11290
'
' * A - COMMAND FROM 5- USER MAINTENANCE OPTIONS (ADD USER)
'
12300 WasA1$ = ""
Attempts = 0
FirstNameSave$ = ZFirstName$
LastNameSave$ = ZLastName$
ActiveUserNameSave$ = ZActiveUserName$
CityStateSave$ = ZWasCI$
HashValueSave$ = HashValue$
IndivValueSave$ = ZIndivValue$
GOSUB 12500
GOSUB 12840
GOSUB 12850
GOSUB 12598
IF ZUserFileIndex = 0 THEN _
GOSUB 12984 : _
GOTO 12330
IF Found THEN _
WasD$ = "User already exists" : _
NumReturns = 1 : _
CALL LPrnt(WasD$,NumReturns) : _
GOSUB 12984 : _
GOTO 12330
12310 GOSUB 12630
GOSUB 12800
GOSUB 11395
ZTempSecLevel = WasOF
CALL SetNewUserDef
LSET ZLastDateTimeOn$ = ZCurDate$ + _
" " + _
ZTimeLoggedOn$
GOSUB 12960
CALL AllCaps (ZUserIn$)
LSET ZCityState$ = ZUserIn$
LSET ZElapsedTime$ = MKI$(0)
IF ZStartHash > 1 THEN _
MID$(ZUserRecord$,ZStartHash,ZLenHash) = HashValue$
IF ZStartIndiv > 1 THEN _
MID$(ZUserRecord$,ZStartIndiv,ZLenIndiv) = ZIndivValue$
GOSUB 29440
12320 GOSUB 12991
12330 ZUserSecLevel = UserSecLevelSave
ZFirstName$ = FirstNameSave$
ZLastName$ = LastNameSave$
ZActiveUserName$ = ActiveUserNameSave$
ZWasCI$ = CityStateSave$
HashValue$ = HashValueSave$
ZIndivValue$ = IndivValueSave$
ZUserFileIndex = WasTU
LSET ZUserRecord$ = UserRecordHold$
GOTO 11001
'
' * GET USER First AND Last NAMES
'
12500 IF Attempts > 5 THEN _
ZFF = ZTrue : _
RETURN
12510 GOSUB 12700
Attempts = Attempts + 1
ZOutTxt$ = WasA1$ + _
ZFirstNamePrompt$
CALL SkipLine (1)
ZLogonActive = ZTrue
GOSUB 12555
IF ZWasQ = 0 THEN _
GOTO 12500
ZLogonActive = ZFalse
CALL Trim (ZWasZ$)
ZFirstName$ = ZWasZ$
12530 ZOutTxt$ = WasA1$ + _
ZLastNamePrompt$
ZParseOff = ZTrue
GOSUB 12555
IF ZWasQ = 0 THEN _
GOTO 12500
12540 CALL Trim (ZWasZ$)
ZLastName$ = ZWasZ$
IF LEN(ZLastName$) < 2 THEN _
IF LEN(ZFirstName$) > 2 THEN _
GOTO 12500
IF (LEN(ZFirstName$) + LEN(ZLastName$)) > 30 THEN _
GOTO 12500
IF UserSecLevelSave < ZSysopSecLevel THEN _
IF (LEN(ZFirstName$) < 2 OR LEN(ZLastName$) < 2) THEN _
GOTO 12500 _
ELSE IF LEFT$(ZFirstName$,1)=" " OR LEFT$(ZLastName$,1)=" " THEN _
GOTO 12500
12550 ZActiveUserName$ = MID$(ZFirstName$ + " " + ZLastName$,1,31)
IF HashIndiv > 1 THEN _
IF ZWasQ < 3 THEN _
GOSUB 12558 : _
IF ZNo THEN _
GOTO 12500
ZWasZ$ = ZFirstName$
RETURN
'
' * CHECK FOR NAMES NOT ALLOWED
'
12555 GOSUB 12932
IF ZWasQ = 0 THEN _
RETURN ' 12500
12556 ZWasZ$ = ZUserIn$(ZAnsIndex)
12557 CALL AllCaps (ZWasZ$)
CALL RemNonAlf (ZWasZ$,31,91)
RETURN
12558 ZOutTxt$ = "Are you '" + _
ZActiveUserName$ + _
"' ([Y],N)"
GOSUB 12995
RETURN
'
' * COMMON SEARCH USER FILE ROUTINE
'
12598 TempHashValue$ = HashValue$
TempIndivValue$ = ZIndivValue$
12600 GOSUB 24910
GOSUB 12988
IF ZInConfMenu THEN _
IF NOT ZPrivateDoor THEN _
X = 46 : _ 'Pe 01/17/93
Gosub 30000 : _ 'Pe 01/17/93
CALL QuickTPut1 (OutTxt$)
12605 CALL OpenUser (ZHighestUserRecord)
GOSUB 29450
CALL FindUser (TempHashValue$,TempIndivValue$,ZStartHash,ZLenHash,_
ZStartIndiv,ZLenIndiv,ZHighestUserRecord,Found,_
ZUserFileIndex,ZWasSL)
IF Found THEN _
RETURN
IF CurUserCount < (ZHighestUserRecord-1)*.95 THEN _
RETURN
ZOutTxt$ = "No room for new users in " + ZConfName$
CALL UpdtCalr (ZOutTxt$,2)
IF ZActiveUserFile$ <> ZMainUserFile$ THEN _
ZUserFileIndex = 0 : _
RETURN
IF ZRememberNewUsers AND NOT ZSurviveNoUserRoom THEN _
ZOutTxt$ = "Sorry, " + _
ZFirstName$ + _
", " + _
ZOutTxt$ : _
GOTO 12975
ZUserFileIndex = 0
IF ZSurviveNoUserRoom THEN _
ZRememberNewUsers = ZFalse
RETURN
'
'
12630 GOSUB 23000
CurUserCount = CurUserCount + (ZWasSL = 0) * ZRememberNewUsers
12632 GOSUB 24000
GOSUB 12985
IF ZRememberNewUsers THEN _
GOSUB 12989
GOSUB 12990
RETURN
'
'
' * INFORM USER OF WHAT CONFERENCE USER FILE HE IS VIEWING
'
12700 IF ZConfMode THEN _
ZOutTxt$ = "Users of " + _
ZConfName$ + _
":" : _
GOSUB 12979
RETURN
'
'
' * GET PASSWORD FROM NEWUSER
'
12800 x = 310 'Pe 02/02/93
Gosub 30000 'Pe 02/02/93
CALL NewPassword (OutTxt$,ZFalse)
IF ZSubParm < 0 THEN _
exit sub
IF UserSecLevelSave < ZSysopSecLevel THEN _
IF ZUserIn$ = SPACE$(LEN(ZUserIn$)) THEN _
GOTO 12800
LSET ZPswd$ = ZWasZ$
RETURN
'
'
'
12840 IF ZStartHash = 1 THEN _
HashValue$ = ZActiveUserName$ : _
RETURN
WasX$ = WasA1$ + _
ZPromptHash$
CALL UntilRight (WasX$,HashValue$,2,ZLenHash)
RETURN
'
'
'
' * GET FIELD TO INDIVIDUATE ONE USER FROM ANOTHER (NAME FIELD IS DEFAULT)
'
12850 IF ZStartIndiv < 1 OR ZLenIndiv < 1 THEN _
RETURN
IF ZStartIndiv = 1 THEN _
ZIndivValue$ = ZActiveUserName$ : _
RETURN
IF ZExitToDoors THEN _
RETURN
WasX$ = WasA1$ + _
ZPromptIndiv$
CALL UntilRight (WasX$,ZIndivValue$,2,ZLenIndiv)
RETURN
'
'
'
12930 ZTurboKey = -ZTurboKeyUser
12932 CALL PopCmdStack
GOTO 12997
'
' * GET CITY AND STATE FROM NEWUSER
'
12960 ZOutTxt$ = WasA1$ + _
ZUserLocation$
IF NOT ZNewUser THEN _
ZOutTxt$ = ZOutTxt$ + ZPressEnter$
ZParseOff = ZTrue
GOSUB 12932
IF ZWasQ = 0 OR ZUserIn$ = SPACE$(LEN(ZUserIn$)) THEN _
IF ZNewUser THEN _
GOTO 12960 _
ELSE RETURN
CALL AllCaps (ZUserIn$)
CALL QuickTPut1 ("Set to "+ZUserIn$)
LSET ZCityState$ = ZUserIn$
ZWasCI$ = ZUserIn$
RETURN
'
'
' * S - COMMAND FROM 5 - USER MAINTENANCE OPTIONS (SCAN USERS)
'
12962 WasX = 0
ZFF = ZFalse
ZMacroMin = 99
ZOutTxt$ = "String to search"
GOSUB 12998
IF ZWasQ = 0 THEN _
GOTO 11001
CALL AllCaps (ZUserIn$)
WasWK$ = ZUserIn$
IF ScanFunction$ = "L" THEN _
WasWK$ = "," + _
STR$(VAL(WasWK$)) + _
","
12963 GET 5,WasI
GOSUB 12966
WasX = INSTR(ScanField$,WasWK$)
IF WasX > 0 THEN _
GOTO 11015
12965 WasI = WasI + 1
IF WasI > ZHighestUserRecord THEN _
LSET ZUserRecord$ = UserRecordHold$ : _
GOTO 11001
WasX = 0
GOTO 12963
12966 ZFF = INSTR("NCPLH",ScanFunction$)
12967 ON ZFF GOTO 12968,12969,12970,12972,12971
GOTO 11001
'
' * N - COMMAND FROM 5 - USER MAINTENANCE SCAN FUNCTION (SEARCH FOR NAME)
'
12968 ScanField$ = ZUserName$
RETURN
'
' * C - COMMAND FROM 5 - USER MAINTENANCE SCAN FUNCTION (SEARCH FOR CITY/ST)
'
12969 ScanField$ = ZCityState$
RETURN
'
' * P - COMMAND FROM 5 - USER MAINTENANCE SCAN FUNCTION (SEARCH FOR PASSWORD)
'
12970 ScanField$ = ZPswd$
RETURN
'
' * H - COMMAND FROM 5 - USER MAINTENANCE SCAN FUNCTION (SEARCH FOR HASH ID)
'
12971 IF ZStartHash > 0 AND ZLenHash > 0 THEN _
ScanField$ = MID$(ZUserRecord$,ZStartHash,ZLenHash)
RETURN
'
' * L - COMMAND FROM 5 - USER MAINTENANCE SCAN FUNCTION (SEARCH FOR LEVEL)
'
12972 ScanField$ = "," + _
STR$(CVI(ZSecLevel$)) + _
","
RETURN
'
'
'
' * STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL OUTPUT ROUTINE
'
12975 ZSubParm = 1
GOTO 12981
12976 ZSubParm = 2
GOTO 12981
12977 ZSubParm = 3
GOTO 12981
12978 ZSubParm = 4 ' no cr/lf
GOTO 12981
12979 ZSubParm = 5 ' cr/lf
GOTO 12981
12980 ZSubParm = 6
12981 CALL TPut
12983 IF ZSubParm < 0 THEN _
exit sub
IF ZSubParm = 8 THEN _
GOSUB 12995
RETURN
'
' * STANDARD ENTRY FOR RBBS-PC'S FILE LOCKING WHEN RUNNING MULTIPLE RBBS-PC'S
'
12984 ZSubParm = 1 ' LOCK USERS & MESSAGES
GOTO 12994
12985 ZSubParm = 2 ' UNLOCK MESSAGES AND FLUSH
Flushed = ZTrue
GOTO 12994
12986 ZSubParm = 3 ' LOCK MESSAGES
GOTO 12994
12987 ZSubParm = 4 ' UNLOCK MESSAGES
GOTO 12994
12988 ZSubParm = 5 ' LOCK USERS
GOTO 12994
12989 ZSubParm = 6 ' LOCK USER BLOCK
GOTO 12994
12990 ZSubParm = 7 ' UNLOCK USERS
GOTO 12994
12991 ZSubParm = 8 ' UNLOCK USER BLOCK
GOTO 12994
12994 CALL FileLock
IF Flushed THEN _
FIELD 1,128 AS ZMsgRec$ : _
Flushed = ZFalse
IF ZSubParm = -1 THEN _
ZSubParm = -9 : _
CALL FindFKey : _
Exit Sub
RETURN
'
' * STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL INPUT ROUTINE
'
12995 GOSUB 12997
ZSubParm = 1
12996 CALL TGet
12997 IF ZSubParm < 0 THEN _
EXIT SUB
RETURN
12998 ZOutTxt$ = ZOutTxt$ + _
ZPressEnter$
GOTO 12995
12999 ZTurboKey = -ZTurboKeyUser
GOTO 12995
13600 CLS
LOCATE ,,0
CALL PScrn (ZWasDF$ + " file missing/invalid. Run CONFIG")
CALL DelayTime (3)
END
20093 LSET ZUserRecord$ = UserRecordHold$
GOSUB 29500
Exit Sub
'
'
' * GET MESSAGE HEADER RECORD DATA
'
23000 GET 1,1
HighMsgNumber = VAL(LEFT$(ZMsgRec$,8))
AutoAddSec = CVI(MID$(ZMsgRec$,9,2))
CallsToDate! = VAL(MID$(ZMsgRec$,11,10))
ZMsgSecCats$ = LEFT$("U",-(MID$(ZMsgRec$,21,1) <> "/")) + _
LEFT$("R",-(MID$(ZMsgRec$,22,1) <> "/")) + _
LEFT$("P",-(MID$(ZMsgRec$,23,1) <> "/")) + "E"
IF ZUserSecLevel >= ZSecKillAny THEN _
ZMsgSecCats$ = "URPE"
IF ZMsgSecCats$ = "E" THEN _
ZMsgSecCats$ = "UE"
CurUserCount = VAL(MID$(ZMsgRec$,57,5))
FirstMsgRecord = VAL(MID$(ZMsgRec$,68,7))
ZNextMsgRec = VAL(MID$(ZMsgRec$,75,7))
HighestMsgRecord = VAL(MID$(ZMsgRec$,82,7))
IF ZActiveMessageFile$ = ZOrigMsgFile$ THEN _
ZMaxNodes = VAL(MID$(ZMsgRec$,127))
RETURN
'
' * UPDATE MESSAGE HEADER RECORD DATA
'
24000 MID$(ZMsgRec$,1,8) = STR$(HighMsgNumber)
MID$(ZMsgRec$,11,10) = STR$(CallsToDate!)
MID$(ZMsgRec$,57,5) = STR$(CurUserCount)
MID$(ZMsgRec$,68,7) = STR$(FirstMsgRecord)
MID$(ZMsgRec$,75,7) = STR$(ZNextMsgRec)
MID$(ZMsgRec$,82,7) = STR$(HighestMsgRecord)
PUT 1,1
RETURN
'
'
'
24910 GOSUB 12986
Gosub 25344
IF LOF(1) = 0 THEN
ZWasDF$ = ZActiveMessageFile$
CLOSE 1
KILL ZActiveMessageFile$
GOSUB 12987
CLS
LOCATE ,,0
CALL PScrn (ZWasDF$ + " file missing/invalid. Run CONFIG")
CALL DelayTime (3)
END
End IF
GOSUB 23000
RETURN
'
'
' **** RESTORE A MESSAGE BASE ***
'
25343 GOSUB 25344
GOSUB 23000
RETURN
'
' ***** OPEN AND SETUP MESSAGE BASE *****
'
25344 CALL OpenMsg
IF ZErrCode = 64 THEN _
ZErrCode = 0 : _
GOTO 25350
FIELD 1, 128 AS ZMsgRec$
RETURN
'
'
25350 IF ZConfName$ <> "MAIN" THEN _
X = 35 : _ 'Pe 01/17/93
Gosub 30000 : _ 'Pe 01/17/93
CALL QuickTPut1 (OutTxt$ + " " + OrigMsgName$)
ZActiveUserName$ = ZOrigUserNameDgs$ 'Dgs-ALias
ZFirstName$ = OrigFirstName$ 'Dgs-ALias
CALL DeLink (ZConfName$)
ConfFileName$ = OrigMsgName$
ZNewsFileName$ = OrigNewsFileName$
ZTurboLogon = ZTrue
ZMarkedMsgs$ = ""
ZMarkedFiles$ = "" 'Pe 04/18/92
ZWasQ = 0
ZNewUser = ZFalse
ZInConfMenu = ZTrue
IF ZActiveUserName$ = "SYSOP" THEN _
ZActiveUserName$ = ZSecretName$ : _
CALL Trim (ZActiveUserName$)
ZConfigFileName$ = ZOrigCnfg$
CALL ReadDef (ZConfigFileName$)
IF ZOrigMsgFile$ <> ZActiveMessageFile$ THEN _
ZActiveMessageFile$ = ZOrigMsgFile$ : _
GOSUB 25343
IF ZOrigUserFile$ <> ZActiveUserFile$ THEN _
GOSUB 25380 : _
ZActiveUserFile$ = ZOrigUserFile$ : _
ZActiveUserName$ = ZOrigUserName$ : _
GOSUB 12598 : _
GOSUB 12990 : _
IF Found THEN _
GOSUB 29500 : _ 'Was 9500
ZMainUserFileIndex = ZUserFileIndex : _
CALL SetPrompt : _
CALL XferType (2,ZTrue) _
ELSE ZUserFileIndex = 0 : _
ZMainUserFileIndex = 0
CALL UpdtCalr (ZActiveUserName$ +" Exited " + ZConfName$,3) 'Pe 11/07/91
ZConfName$ = "MAIN"
ConfNameSave$ = ZConfName$
IF ZCurPUI$ = "" OR ZSubBoard THEN _
ZCurPUI$ = ZMainPUI$
CALL FindIt (ZCurPUI$)
ZCustomPUI = ZOK
IF NOT ZOK THEN _
ZCurPUI$ = ""
ZPrevPUI$ = ""
ZUplds = ZGlobalUplds
ZDnlds = ZGlobalDnlds
ZDLToday! = ZGlobalDLToday!
ZBytesToday! = ZGlobalBytesToday!
ZDLBytes! = ZGlobalDLBytes!
ZULBytes! = ZGlobalULBytes!
ZBankTime = ZGlobalBankTime
25360 ZConfMode = ZFalse
BoardCheckDate$ = ZLastDateTimeOn$
ZSubBoard = ZTrue
GOSUB 12987
25375 IF ((ZUserSecLevel < ZAutoUpgradeSec) AND ZSubBoard) OR _
((ZUserSecLevel < OrigUpgradeSec) AND NOT ZSubBoard) THEN _
IF ZUserSecLevel <> ZOrigSec THEN _
ZUserSecLevel = ZOrigSec : _
LSET ZSecLevel$ = MKI$(ZUserSecLevel)
RETURN
'
' ***** UPDATE CURRENT USERS RECORD ****
'
25380 IF ZUserFileIndex < 1 THEN _
RETURN
IF ZAdjustedSecurity AND NOT ZSysop THEN _
LSET ZSecLevel$ = MKI$(ZUserSecLevel) : _
ZUserSecSave = ZUserSecLevel
IF ZSubBoard THEN _ 'Dgs-ALias
ZActiveUserName$ = ZOrigUserNameDgs$ : _ 'Dgs-ALias
ZFirstName$ = OrigFirstName$ 'Dgs-ALias
CALL UpdateU (ZFalse)
RETURN
'
'
29440 IF ZUserFileIndex > 0 AND ZUserFileIndex < 32768 THEN _
PUT 5,ZUserFileIndex
RETURN
'
29450 IF LOF(5) < 1 THEN
ZWasDF$ = ZActiveUserFile$
CLS
LOCATE ,,0
CALL PScrn (ZWasDF$ + " file missing/invalid. Run CONFIG")
CALL DelayTime (3)
END
End IF
FIELD 5,31 AS ZUserName$, _
15 AS ZPswd$, _
2 AS ZSecLevel$, _
14 AS ZUserOption$, _
24 AS ZCityState$, _
2 AS MachineType$, _
1 AS ZBankTime$,_
4 AS ZTodayDl$, _
4 AS ZTodayBytes$, _
4 AS ZDlBytes$, _
4 AS ZULBytes$, _
14 AS ZLastDateTimeOn$, _
3 AS ZListNewDate$, _
2 AS ZUserDnlds$, _
2 AS ZUserUplds$, _
2 AS ZElapsedTime$
FIELD 5,128 AS ZUserRecord$
RETURN
'
29500 GOSUB 29450
CALL SetSysOp
CALL SetUserPref
RETURN
30000 Call GetRBBSString(X,RBBSString$) 'Pe 01/16/93
OutTxt$ = RBBSString$ 'Pe 01/16/93
RETURN
End Sub